C---------------------------------------------------------
C    TOOLPACK/1    Release: %R%.1
C---------------------------------------------------------
C
C  SSTEST - TEST PROGRAM
C           STRING HANDLING SUPPLEMENTARY LIBRARY
C
C  TEST THE ROUTINES IN THE STRING HANDLING SUPPLEMENTARY LIBRARY
C
      PROGRAM SSTEST
 
      INTEGER             LINE1(134), LINE2(134), BODY(134),
     +                    ID(3), LHS(134), RHS(134)
      LOGICAL             FLAG1, FLAG2
      CHARACTER * 134 STRNG1
      INTEGER             BIND, TYPE, START, END, STATUS
      INTEGER             Y,MO,D,H,MI,S,JUNK
      INTEGER             LENGTH, ZSEDID, ZSEDTY, ZSPLIT, ZSETP,  ZSETR,
     +                    ZPFIND, ZPREPL, ZYESNO, ZGTCMD
      EXTERNAL            ZINIT,  ZQUIT,  LENGTH, ZSEDID, ZSEDTY,
     +                    ZSPLIT, ZSETP,  ZSETR,  ZPFIND, ZPREPL,
     +                    ZYESNO, ZGTCMD
 
      CALL ZINIT
C
C  TIME STRING CONVERSION CHECK
C
      CALL ZTIME (Y, MO, D, H, MI, S, JUNK)
      CALL ZTIMST(Y, MO, D, H, MI, S, LINE1)
      CALL ZPTMES(LINE1, 1)
C
C  REQUEST A STRING FOR MODIFICATION FROM THE USER
C
      CALL ZMESS('Enter a string:.', 1)
      STATUS = ZGTCMD(LINE1, 0)
 
C  NORMAL STRING
      CALL ZCHOUT('LINE1 :.', 1)
      CALL ZPTMES(LINE1,     1)
 
C  CONVERT IT TO A FORTRAN 77 STRING (IST FORMAT CONVERSION)
      CALL ZITOF(LINE1, 1, 132, STRNG1, .TRUE.)
      CALL ZCHOUT('ZITOF :.', 1)
      CALL ZMESS (STRNG1,     1)
 
C  CONVERT THE FORTRAN 77 STRING BACK TO AN IST STRING (IST FORMAT CONVERSION)
      CALL ZFTOI(STRNG1, 1, 132, LINE2, .TRUE.)
      CALL ZCHOUT('ZFTOI :.', 1)
      CALL ZPTMES(LINE2,     1)
 
C  CONVERT THE LINE TO UPPER CASE LETTERS
      CALL ZTOCAP(LINE2)
      CALL ZCHOUT('ZTOCAP:.', 1)
      CALL ZPTMES(LINE2,     1)
 
C  CONVERT THE LINE TO LOWER CASE LETTERS
      CALL ZTOLOW(LINE2)
      CALL ZCHOUT('ZTOLOW:.', 1)
      CALL ZPTMES(LINE2,     1)
 
C  RECOVER THE UNMODIFIED LINE
      CALL SCOPY(LINE1, 1, LINE2, 1)
 
C  OUTPUT A COMPACTED VERSION, ALL EXTRANIOUS SPACES REMOVED
      CALL ZPACK(LINE2)
      CALL ZCHOUT('ZPACK :.', 1)
      CALL ZPTMES(LINE2,     1)
 
C  OUTPUT A STRIPPED VERSION WITHOUT SPACES
      CALL ZSTRIP(LINE2)
      CALL ZCHOUT('ZSTRIP:.', 1)
      CALL ZPTMES(LINE2,     1)
C
C  REQUEST A SED STRING FOR MODIFICATION FROM THE USER
C
      CALL SKIP(1)
      CALL ZMESS('Enter a SED format string:.', 1)
      STATUS = ZGTCMD(LINE1, 0)
      IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
        CALL ZMESS('No SED test requested.', 1)
        GO TO 30
      ENDIF
 
C  IS IT A SED?, SPLIT IT UP IF SO
      IF(ZSEDID(LINE1, BIND, ID, BODY) .EQ. -3) THEN
        CALL ZMESS('INVALID SED FORMAT.', 1)
        TYPE = -1
      ELSE
        CALL ZCHOUT('ID     :.', 1)
        CALL ZPTMES(ID, 1)
        CALL ZCHOUT('BODY   :.', 1)
        CALL ZPTMES(BODY, 1)
 
C  IDENTIFY SED BODY TYPE
        IF(ZSEDTY(BODY, TYPE) .EQ. -1) THEN
          CALL ZMESS('INVALID BODY FORMAT.', 1)
        ELSE
          IF(TYPE .EQ. 112) THEN
            CALL ZMESS('BODY TYPE IS PLAIN.', 1)
          ELSE IF(TYPE .EQ. -2) THEN
            CALL ZMESS('BODY TYPE SWITCH ON.', 1)
          ELSE IF(TYPE .EQ. -3) THEN
            CALL ZMESS('BODY TYPE SWITCH OFF.', 1)
          ELSE
            CALL ZMESS('UNKNOWN BODY TYPE.', 1)
          ENDIF
        ENDIF
      ENDIF
 
C  SPLIT UP THE PLAIN TYPE
      IF(TYPE .EQ. 112) THEN
        IF(ZSPLIT(BODY, LHS, RHS) .EQ. -1) THEN
          CALL ZMESS('BODY IS NOT AN ASSIGNMENT.', 1)
        ELSE
          CALL ZCHOUT('LHS:.', 1)
          CALL ZPTMES(LHS, 1)
          CALL ZCHOUT('RHS:.', 1)
          CALL ZPTMES(RHS, 1)
        ENDIF
      ENDIF
C
C  PATTERN HANDLING TESTS
C
      CALL SKIP(1)
   30 CONTINUE
      CALL ZMESS('Enter a pattern string:.', 1)
      STATUS = ZGTCMD(LINE1, 0)
      IF(ZSETP(LINE1, .TRUE.) .EQ. -1) THEN
        CALL ZMESS('PATTERN ERROR.', 1)
        GO TO 30
      ENDIF
   40 CONTINUE
      CALL ZMESS('Enter a replacement string:.', 1)
      STATUS = ZGTCMD(LINE1, 0)
      IF(ZSETR(LINE1) .EQ. -1) THEN
        CALL ZMESS('REPLACEMENT STRING ERROR.', 1)
        GO TO 40
      ENDIF
 
C  CONTINUE CHECKING UNTIL A NULL LINE IS ENTERED
   50 CONTINUE
      CALL SKIP(1)
      CALL ZMESS
     +('Enter a line to be examined:.', 1)
      STATUS = ZGTCMD(LINE1, 0)
      IF(LENGTH(LINE1) .GT. 0) THEN
        IF(ZPFIND(LINE1, 1, START, END) .EQ. -2) THEN
          CALL ZCHOUT('MATCH FOUND BETWEEN .', 1)
          CALL PUTDEC(START, 1)
          CALL ZCHOUT(' AND .', 1)
          CALL PUTDEC(END, 1)
          CALL SKIP(1)
        ELSE
          CALL ZMESS('NO MATCH FOUND.', 1)
        ENDIF
        IF(ZPREPL(LINE1, LINE2, .TRUE.) .EQ. -2) THEN
          CALL ZCHOUT('CHANGED LINE:.', 1)
          CALL ZPTMES(LINE2, 1)
        ELSE
          CALL ZMESS('NO REPLACEMENT POSSIBLE.', 1)
        ENDIF
 
      ENDIF
 
      CALL ZMESS('Do you wish to continue.', 1)
      IF(ZYESNO(-2) .EQ. -2) GO TO 50
      CALL ZMESS('Are you sure.',1)
      IF(ZYESNO(-3)  .EQ. -3)  GO TO 50
 
   60 CONTINUE
      CALL SKIP(1)
      CALL ZMESS('Enter a variable name (e-o-f to end):.', 1)
      STATUS = ZGTCMD(LINE1, 0)
      IF(STATUS .NE. -100) THEN
        CALL ZLEGAL(LINE1, FLAG1, FLAG2)
        IF(FLAG1) CALL ZMESS('Legal standard Fortran variable name.',1)
        IF(.NOT. FLAG1)
     +    CALL ZMESS('Illegal standard Fortran variable name.',1)
        IF(FLAG2) CALL ZMESS('Legal local Fortran variable name.',1)
        IF(.NOT. FLAG2)
     +    CALL ZMESS('Illegal local Fortran variable name.',1)
        GO TO 60
      ENDIF
 
      CALL ZQUIT(-2)
 
      END
